with System;
with Ada.Unchecked_Conversion;
with Interfaces.C; use Interfaces.C;
with Win32;
with strings;

package body ffxilog_interface.encoding is
  function GetACP return Win32.UINT;
  pragma Import (Stdcall, GetACP, "GetACP");

  function MultiByteToWideChar (CodePage : in Win32.UINT;
                                dwFlags : in Win32.DWORD;
                                lpMultiByteStr : in Win32.LPCSTR;
                                cbMultiByte : in Win32.Int;
                                lpWideCharStr : in Win32.LPWSTR;
                                cchWideChar : in Win32.Int)
                                return Win32.Int;
  pragma Import (Stdcall, MultiByteToWideChar, "MultiByteToWideChar");
  function WideCharToMultiByte (CodePage : in Win32.UINT;
                                dwFlags : in Win32.DWORD;
                                lpWideCharStr : in Win32.LPCWSTR;
                                cchWideChar : in Win32.Int;
                                lpMultiByteStr : in Win32.LPSTR;
                                cbMultiByte : in Win32.Int;
                                lpDefaultChar : in Win32.LPCSTR;
                                lpUsedDefaultChar : in Win32.LPBOOL)
                                return Win32.Int;
  pragma Import (Stdcall, WideCharToMultiByte, "WideCharToMultiByte");

  function WToA (st : in Wide_String;
                 cpg : in Win32.UINT := Win32.UINT'last;
                 lFlags : in Win32.DWORD := 0) return string is
    function To_LPCWSTR is new
      Ada.Unchecked_Conversion
        (System.Address,
         Win32.LPCWSTR);
    function To_LPSTR is new
      Ada.Unchecked_Conversion
        (System.Address,
         Win32.LPSTR);
    function To_LPCSTR is new
      Ada.Unchecked_Conversion
        (System.Address,
         Win32.LPCSTR);
    function To_LPBOOL is new
      Ada.Unchecked_Conversion
        (System.Address,
         Win32.LPBOOL);

    cpg2 : Win32.UINT;
    cwch : Win32.Int;
  begin
    if cpg = Win32.UINT'last then cpg2 := GetACP; else cpg2 := cpg; end if;
    cwch := WideCharToMultiByte(cpg2, lFlags, To_LPCWSTR(st'Address), -1,
                                To_LPSTR(System.Null_Address), 0,
                                To_LPCSTR(System.Null_Address),
                                To_LPBOOL(System.Null_Address));
    declare
      stBuffer : string (1..Integer(cwch)+1);
    begin
      cwch := WideCharToMultiByte(cpg2, lFlags, To_LPCWSTR(st'Address), -1,
                                  To_LPSTR(stBuffer'Address),
                                  Win32.Int(stBuffer'Length),
                                  To_LPCSTR(System.Null_Address),
                                  To_LPBOOL(System.Null_Address));
      return stBuffer(1..Integer(cwch)-1);
--      If cpg = -1 Then cpg = GetACP()
--      pwz = StrPtr(st)
--      cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, 0&, 0&, ByVal 0&, ByVal 0&)
--      stBuffer = String$(cwch + 1, vbNullChar)
--      pwzBuffer = StrPtr(stBuffer)
--      cwch = WideCharToMultiByte(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer), ByVal 0&, ByVal 0&)
--      WToA = Left$(stBuffer, cwch - 1)
    end;
  end WToA;

  function AToW (st : in char_array;
                 cpg : in Win32.UINT := Win32.UINT'last;
                 lFlags : in Win32.DWORD := 0) return wchar_array is
    function To_LPCSTR is new
      Ada.Unchecked_Conversion
        (System.Address,
         Win32.LPCSTR);
    function To_PWCH is new
      Ada.Unchecked_Conversion
        (System.Address,
         Win32.PWCH);

    cpg2 : Win32.UINT;
    stBuffer : wchar_array(1..150);
    cwch : Win32.Int;
  begin
    if cpg = Win32.UINT'last then cpg2 := GetACP; else cpg2 := cpg; end if;
    cwch := MultiByteToWideChar(cpg2, lFlags, To_LPCSTR(st'Address), -1,
                                To_PWCH(System.Null_Address), 0);
    cwch := MultiByteToWideChar(cpg2, lFlags, To_LPCSTR(st'Address), -1,
                                To_PWCH(stBuffer'Address), stBuffer'Length);
    return stBuffer (size_t(1)..size_t(cwch));
--      If cpg = -1 Then cpg = GetACP()
--      pwz = StrPtr(st)
--      cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, 0&, 0&)
--      stBuffer = String$(150, vbNullChar)
--      pwzBuffer = StrPtr(stBuffer)
--      cwch = MultiByteToWideChar(cpg, lFlags, pwz, -1, pwzBuffer, Len(stBuffer))
--      AToW = Left$(stBuffer, cwch - 1)
  end AToW;

  function DecodeUTF8 (cnvUni : in string) return wide_string is
    --cnvUni2 : string(cnvUni'Range);

    CP_ACP : constant Interfaces.C.Unsigned := 0;
    CP_JAPAN : constant Interfaces.C.Unsigned := 932;

    type two_char is new string (1..2);
    function To_wide_char is new
      Ada.Unchecked_Conversion
        (two_char,
         wide_character);

    type charandpos is record
      c : wide_character;
      pos : Integer;
    end record;
    type charandpos_array is array (1..cnvUni'length) of charandpos;
    UniChars : charandpos_array;
    n : integer;

    procedure Find_Unicode_Chars is
      i : integer;
    begin
      i := 1; n := 0;
      while i <= cnvUni'length-1 loop
        if cnvUni(i) = character'val(133) then
          UniChars(i).c := To_wide_char (cnvUni(i)&cnvUni(i+1));
          UniChars(i).pos := i;
          n := n+1;
        end if;
        i := i+1;
      end loop;
    end Find_Unicode_Chars;

    function Replace_Unicode_Chars (str : in wide_string) return wide_string is
      type limstr is new string(1..str'length*2);
      type limwstr is new string(1..str'length);
      function To_wide is new
        Ada.Unchecked_Conversion
          (limwstr,
           limstr);

      result : wide_string(str'range);
      i : integer;
    begin
      i := 1; result := str;
      while i <= n loop
        --Put_Line("Length "&Integer'Image(str'Length)&"Chars"&Integer'Image(n));
        result(UniChars(i).pos) := UniChars(i).c;
        i := i+1;
      end loop;
      return result;
    end Replace_Unicode_Chars;
  begin
    if cnvUni = "" then return ""; end if;
    --Find_Unicode_Chars;
    return To_Ada (AToW (To_C (
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(
             Strings.Replace(cnvUni,
               character'val(16#1E#)&character'val(16#1#), ""),
               character'val(16#1E#)&character'val(16#2#), ""),
               character'val(16#1E#)&character'val(16#3#), ""),
               character'val(16#EF#)&character'val(16#27#),
               character'val(123)&""), -- AutoTrans OpenBracket
               character'val(16#EF#)&character'val(16#28#),
               character'val(125)&""), -- AutoTrans CloseBracket
               character'val(16#7F#)&character'val(16#31#), ""),
               character'val(16#1F#)&character'val(16#F#), ""),
               character'val(16#1F#)&character'val(16#79#), ""),
               character'val(16#1F#)&character'val(16#7B#), ""),
               character'val(16#1F#)&character'val(16#7F#), ""),
               character'val(16#1F#)&character'val(16#88#), ""),
               character'val(16#1F#)&character'val(16#8D#), ""),
               character'val(16#1F#)&character'val(16#D0#), ""),
               character'val(16#1F#)&character'val(16#8A#), "")),
             CP_JAPAN));
  end DecodeUTF8;
end ffxilog_interface.encoding;
